home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / asorts.zip / TSTSRT.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  6KB  |  168 lines
  1. program tstsrt;
  2. { Exercises most of the facilities of the ASORTS unit }
  3.  
  4. uses asorts;
  5.  
  6. { $define MONITOR} {<-- MONITOR needs to be defined in ASORTS.PAS
  7.                         also }
  8.  
  9. const
  10.   max = 19; { must be byte-sized }
  11.  
  12. type
  13.   list = array[1..max] of integer;
  14.  
  15. var
  16.   data,data2: list;
  17.   i: integer;
  18.   b:integer;
  19.   sortcount,qsc:integer;
  20.  
  21. const
  22.   bs : set of byte = [];
  23.   cmax:word=0;
  24.  
  25. function intcomp(var a,b):longint; far;
  26. var int1: integer absolute a;
  27.     int2: integer absolute b;
  28. begin
  29.   if int1<int2 then intcomp:=-1
  30.   else if int1=int2 then intcomp:=0
  31.   else intcomp:=1;
  32. end;
  33.  
  34. procedure datamon; far; var i:byte; begin
  35.   inc(sortcount); for i:=1 to cmax do write(data[i]:4); writeln; end;
  36.  
  37. begin {tstsrt}
  38.   Writeln('Now generating up to ',max,' random numbers...');
  39.   Randomize;
  40.   for i:=1 to max do begin
  41.       b:=random(256);
  42.  
  43.       { If "b" has already been generated, "lsearch" should find it;
  44.         otherwise "lsearch" should add it to the end. }
  45.  
  46.       if b in bs then
  47.          if lsearch(b,data,cmax,sizeof(integer),intcomp)>cmax then
  48.             writeln('Error in "lsearch": element not found ',b)
  49.          else
  50.       else if lsearch(b,data,cmax,sizeof(integer),intcomp)<=cmax then
  51.          writeln('Error in "lsearch": invalid element inserted ',b)
  52.       else begin bs:=bs + [b]; inc(cmax) end; end;
  53.   datamon; write(' (Press return)'); readln;
  54.  
  55.   Writeln('Now sorting ',cmax,' random numbers...');
  56.  
  57. {$ifdef MONITOR}  { This will let us keep track of the how the sort is
  58.                   progressing }
  59. { !!! MONITOR must be defined in ASORTS for this to work }
  60. asorts.monitor:=datamon;
  61. data2:=data; {for subsequent comparison}
  62. sortcount:=0;
  63. {$endif}
  64.  
  65.   qsort(data,cmax,sizeof(integer),intcomp);
  66.  
  67. {$ifdef MONITOR}
  68. qsc:=sortcount; sortcount:=0;
  69. writeln('Now let''s see how the NaiveSort compares to the QuickSort that');
  70. writeln('   we just finished');
  71.   write(' (Press return)'); readln;
  72.  
  73. data:=data2;
  74. naivesort(data,cmax,sizeof(integer),intcomp);
  75.  
  76. writeln('And the score is: QSort:',qsc,', vs NaiveSort:',sortcount, 'swaps');
  77.  
  78. { This is not important for this program, but if you call "qsort" from
  79.   multiple locations, what the procedure does might not always make sense.
  80.   So, we turn the monitor off. }
  81.  
  82. asorts.nullmonitor;
  83.  
  84. {$else}
  85.   datamon;
  86. {$endif}
  87.   write(' (Press return)'); readln;
  88.   writeln('Now searching for ',cmax,' sorted numbers...');
  89.   for i:=0 to 255 do begin
  90.       { All byte values will be sought.  It would be an error for
  91.         "bsearch" to find a value that was not inserted into the
  92.         array.  Also, to fail to find a value that was inserted
  93.         into the array }
  94.       if bsearch(i,data,cmax,sizeof(integer),intcomp)=0 then
  95.          if i in bs then
  96.             Writeln('Error in "bsearch": element not found ',i)
  97.          else
  98.       else if not (i in bs) then
  99.          writeln('Error in "bsearch": invalid element found ',i)
  100.       else if i<>data[bsearch(i,data,cmax,sizeof(integer),intcomp)] then
  101.          writeln('Error in "bsearch": wrong index returned');
  102.  
  103.       if fibsearch(i,data,cmax,sizeof(integer),intcomp)=0 then
  104.          if i in bs then
  105.             Writeln('Error in "fibsearch": element not found ',i)
  106.          else
  107.       else if not (i in bs) then
  108.          writeln('Error in "fibsearch": invalid element found ',i)
  109.       else if i<>data[fibsearch(i,data,cmax,sizeof(integer),intcomp)] then
  110.          writeln('Error in "fibsearch": wrong index returned');
  111.       end;
  112.   writeln('....Search complete.');
  113.  
  114.   { We are now going to exercise the submove and xsubmove procedures
  115.     in ASORTS.  For the simple submove, the first five elements of "data"
  116.     are going to be moved to "pseudo" array that starts at data[9].  The
  117.     target array is presumed to consist of elements that are two integers
  118.     in size.  So, the moved values will wind up in every other integer
  119.     displayed.}
  120.   writeln('Now doing a simple array submove ... (1->9,2->11,...5->17)');
  121.   submove(data[1],data[9],5,2,4);
  122.   datamon; write(' (Press return)'); readln;
  123.  
  124.  
  125.   { For the more general "xsubmove", we are going to presume that the
  126.     source array is also two integers per element, but we only want to move
  127.     the first element.  (The source and target are overlayed in this example
  128.     so that what is seen are pairs of numbers appear in "data".) }
  129.   writeln('Now doing a complex array submove ...(1->2,3->4,...9->10)');
  130.   xsubmove(data[1],data[2],5,4,4,2);
  131.   datamon; write(' (Press return)'); readln;
  132.  
  133.   { Now put 255 into the even slots }
  134.   writeln('Now interlacing "255" into the array');
  135.   b:=255;
  136.   subfill(b,data[2],9,2,4);
  137.   datamon; write(' (Press return)'); readln;
  138.  
  139.   { Now put 0 everywhere }
  140.   writeln('Now filling array with 0''s...');
  141.   b:=0;
  142.   fill(b,data,19,sizeof(integer));
  143.   datamon; write(' (Press return)'); readln;
  144.  
  145.   { Now let's tryout the binary insertion procedure }
  146.   writeln('Now creating a new, sorted random array ... ');
  147.   cmax:=0; bs:=[];
  148.   for i:=1 to max do begin
  149.       b:=random(256);
  150.       b:=binsert(b,data,cmax,sizeof(integer),intcomp);
  151.       inc(cmax); end;
  152.   datamon; write(' (Press return)'); readln;
  153.  
  154.   { Now, let's check out the swab procedure }
  155.   writeln('Now swabbing the array...results should be the same');
  156.   swab(data,data,19); datamon;
  157.   swab(data,data,19); datamon;
  158.   write(' (Press return)'); readln;
  159.  
  160.   { That only leaves "shuffle" to be exercised, so let's mess up everything
  161.     before we exit. }
  162.   writeln('Now shuffling ',cmax,' numbers...');
  163.   shuffle(data,cmax,sizeof(integer));
  164.   datamon; write(' (Press return)'); readln;
  165.  
  166.   writeln('Done.');
  167. end.
  168.